Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d1/filecat.arc/FILECAT.PAS

Pascal/Delphi Source File | 1986-05-14 | 43.0 KB | 1,392 lines

{.n finc01}
{.n finc02}

{$C-}

PROGRAM FILECAT; { Written 2/2/86 by Kenn Flee, Madison WI }
                 { Requires Turbo 3.X and Database ToolBox }
                 { Copyright (C) 1986 by Jamestown Software}
                 { NonCommercial use only................. }

                 { Configured for TurboPower Extender..... }

CONST
  MaxDataRecSize = 600;
  MaxKeyLen      =  20;
  PageSize       =  24;
  Order          =  12;
  PageStackSize  =   8;
  MaxHeight      =   5;

{.L-}

{$I ACCESS.BOX}
{$I GETKEY.BOX}
{$I ADDKEY.BOX}
{$I DELKEY.BOX}
{$I SORT.BOX}

{.L+}

TYPE
  Name = String[12];
  Str3 = String[3];
  Str8 = String[8];
  Str11 = String[11];
  Str15 = String[15];
  Str42 = String[42];
  Str79 = String[79];
  Str80 = String[80];
  Str255 = String[255];
  AnyStr = String[255];
  CharSet = Set of Char;
  Reg = Record case Integer of
          1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer);
          2: (AL,AH,BL,BH,CL,CH,DL,DH          : Byte);
        End;
  FRec = Record
           Status : Integer;
           FileName : Name;
           FileTime : Integer;
           FileDate : Integer;
           FileSize : Array[1..4] of Byte;
           Floppy : Boolean;
           VolPath : String[64];
           StandAlone : Boolean;
           ParentName : Name;
           Keys : Str79;
           Description : Array[1..4] of Str79;
         End;

E = Record
    EStatus : Integer;
    EName : String[8];
    EExt  : String[3];
    ETime : Integer;
    EDate : Integer;
    ESize : Array[1..4] of Byte;
  End;
EA = Array[1..400] of E;

C = Record
    CName : Name;
    CNum  : Integer;
  End;


VAR
  ExFile : File;
  BadgeFile : Text;
  CapsLock,
  InsertOn : Boolean;
  FileName : Name;
  Ch : Char;
  MenuChoice,
  ReportChoice : Char;
  TDate : Str8;
  CMode,NewMenu,
  InitFiles :Boolean;
  CFile,
  CFile2 : DataFile;
  KIndex,
  CIndex,
  CIndex2 : IndexFile;
  DOSNum : Str3;
  Error : Integer;
  SortKey : Str42;
  SortKey80 : Str80;
  DTA3 : Array[1..43] of Char;
  ASCIIZ : Array[1..64] of Char;
  ASCIIZ2 : Array[1..64] of Char;
  FileRec         : FRec;
  Regs            : Reg;
  OldVolumeName   : String[11];
  OldVolumeNameDate : String[20];
  Drive             : Char;
  EntryDirectory,
  SourceDirectory,
  Directory         : String[80];
  Day,Month,Year,
  Hour,Minute  : Integer;
  Size         : Real;
  AP           : Char;
  Entry        : EA;
  ChildArray   : Array[1..50] of C;
  ChildMatch   : Name;
  ChildCount,
  ChildSelect  : Integer;
  ChildFlag    : Boolean;
  FTemp        : FRec;
  EntryNum     : Integer;
  FKey         : String[14];
  PrintCount   : Integer;
  TransferFile,
  KeySearch    : Boolean;
  FirstCharDelete : Boolean;

PROCEDURE BigWindow(a,b,c,d:Integer);
  Begin
    Window(a,b,c,d);
    { delete next line if NOT using Turbo Extender }
    CloneCodeSegment(TurboRunDataStart,TurboRunDataLength);
  End; { procedure BigWindow(a,b,c,d:Integer) }

{****************************************************************************}
{                               SCRNCODE.PAS                                 }
{****************************************************************************}

CONST  VideoEnable = $08;               { Video Signal Enable Bit }
       On  = True;
       Off = False;

TYPE   Imagetype  = Array[1..4000] of char;  { Screen Image }

VAR    Screen      : Record
                       Image: Imagetype;
                       X1,Y1:   Integer;
                     End;
       Crtmode     : Byte      ABSOLUTE $0040:$0049;
       Monobuffer  : Imagetype ABSOLUTE $B000:$0000;
       Colorbuffer : Imagetype ABSOLUTE $B800:$0000;
       CrtAdapter  : Integer   ABSOLUTE $0040:$0063;
       VideoMode   : Byte      ABSOLUTE $0040:$0065;
       CurrentSaved : Boolean;


PROCEDURE Video(Switch:Boolean); { Video On/Off to avoid Read/Write snow }
  Begin
    If (Switch=Off) then Port[CrtAdapter+4] := (VideoMode-VideoEnable)
      Else Port[CrtAdapter+4] := (VideoMode or VideoEnable);
  End;

PROCEDURE SaveScreen;
  Begin
    If NOT CurrentSaved then begin
      Video(Off);
      With Screen Do Begin
        X1:=WhereX;
        Y1:=WhereY;
        If CrtMode = 7 then Image := Monobuffer Else Image := Colorbuffer ;
      End;
      Video(On);
      CurrentSaved:=True;
    End;
  End; { procedure SaveScreen }

PROCEDURE RestoreScreen;
  Begin
    If CurrentSaved then begin
      Video(Off);
      With Screen Do Begin
        If CrtMode = 7 then Monobuffer := Image Else Colorbuffer := Image;
        GotoXY(X1,Y1);
      End;
      Video(On);
      CurrentSaved:=False;
    End;
  End; { procedure RestoreScreen; }

{$I FMAIN01.INC }

PROCEDURE Boop;
  Begin
    Sound(330);Delay(120);NoSound;
  End; { procedure Boop }

PROCEDURE Parse(VAR EntryStr:AnyStr; VAR ParsedStr:AnyStr);
  VAR I:Integer;
  Begin
    While Pos(' ',EntryStr)=1 do EntryStr:=Copy(EntryStr,2,Length(EntryStr));
    I:=Pos(' ',EntryStr);
    If I=0 then ParsedStr:=EntryStr Else ParsedStr:=Copy(EntryStr,1,I-1);
    If I>0 then EntryStr:=Copy(EntryStr,I+1,Length(EntryStr)) Else EntryStr:='';
  End; { procedure Parse }

PROCEDURE OpenFiles;
  Begin
    ChDir(EntryDirectory);
    If TransferFile then begin
      OpenFile(CFile,'TRANSFER.DAT',SizeOf(FRec));
      OpenIndex(CIndex,'TRANSFER.IXN',14,1);
    End Else begin
      OpenFile(CFile,'FILECAT.DAT',SizeOf(FRec));
      OpenIndex(CIndex,'FILECAT.IXN',14,1);
    End;
    OpenIndex(KIndex,'FILECAT.KWD',15,0);
  End; { procedure OpenFiles }

PROCEDURE CloseFiles;
  Begin
    ChDir(EntryDirectory);
    CloseFile(CFile);
    CloseIndex(KIndex);
    CloseIndex(CIndex);
  End; { procedure CloseFiles }

{.m finc01}

{$I FMAIN02.INC}

{.m mainmodule}

PROCEDURE Show(X,Y:Integer;S:Str80);
  Begin
    GotoXY(X,Y);
    Write(S);
  End; { procedure Show }

PROCEDURE ShowScreen;
  Begin
    ClrScr;
    NormVideo;
    Show(1,2,ConstStr(#196,80));
    LowVideo;
    Show(5,2,' FILE INFORMATION ');
    Show( 3, 4,'   File Name:');
    Show( 3, 5,'        Time:');
    Show( 3, 6,'        Date:');
    Show( 3, 7,'        Size:');
    Show( 3, 8,'     Floppy?:');
    Show(21, 8,'Volume/Path:');
    Show( 3, 9,'Stand Alone?:');
    Show(21, 9,'Main File Name:');
    Show(49, 9,'Extension:');
    NormVideo;
    Show(1,11,ConstStr(#196,80));
    Show(1,15,ConstStr(#196,80));
    Show(1,22,ConstStr(#196,80));
    LowVideo;
    Show(5,11,' KEYWORDS ');
    Show(5,15,' DESCRIPTION ');
    NormVideo;
  End; { procedure ShowScreen }

PROCEDURE UpdateArray;
  VAR I,R : Integer;
      S1,S2 : String[14];
  Begin
    OpenFiles;
    For I:=1 to EntryNum do begin
      Entry[I].EStatus:=0;
      S1:=Entry[I].EName+Entry[I].EExt;
      FKey:=S1;
      ClearKey(CIndex);
      SearchKey(CIndex,R,FKey);
      If OK then Begin
        S2:=Copy(FKey,1,11);
        If S1=S2 then Entry[I].EStatus:=1;
      End;
    End;
    CloseFiles;
  End; { procedure UpdateArray }

PROCEDURE ShowEntry(N:Integer);
  Begin
    With Entry[N] do begin
    GotoXY(17,4);
    Write(EName,'.',EExt);
      Size := (ESize[1] * 1.0) +
              (ESize[2] * 256.0) +
              (ESize[3] * 65536.0);
      Year := (EDate shr 9) + 80;
      Month := (EDate shl 7) shr 12;
      Day := (EDate shl 11) shr 11;
      Hour := ETime shr 11;
      If Hour >= 12 then begin
        AP := 'p';
        Hour := Hour - 12;
      End Else AP := 'a';
      If Hour = 0 then Hour := 12;
      Minute := (ETime shl 5) shr 10;
    End;
    GotoXY(17,5);
    Write(Hour:2,':');
    If Minute < 10 then Write('0');
    Write(Minute,ap);
    GotoXY(17,6);
    Write(Month:2,'-');
    If Day < 10 then Write('0');
    Write(Day,'-',Year);
    GotoXY(17,7);
    Write(Size:0:0);
    GotoXY(17,8);
    If SourceDirectory[1] in ['A','B'] then Write('Yes') Else Write('No');
    GotoXY(34,8);
    If SourceDirectory[1] in ['A','B'] then Write(OldVolumeName)
       Else Write(SourceDirectory);
  End; { procedure ShowEntry }

PROCEDURE ShowData(RecNum:Integer);
  VAR I:Integer;
  Begin
    FillChar(FileRec,SizeOf(FileRec),0);
    GetRec(CFile,RecNum,FileRec);
    With FileRec do begin
      GotoXY(17,4);ClrEol;
      Write(FileName);
      GotoXY(60,4);ClrEol;
      Write('Record No.: ',RecNum);
      Size := (FileSize[1] * 1.0) +
              (FileSize[2] * 256.0) +
              (FileSize[3] * 65536.0);
      Year := (FileDate shr 9) + 80;
      Month := (FileDate shl 7) shr 12;
      Day := (FileDate shl 11) shr 11;
      Hour := FileTime shr 11;
      If Hour >= 12 then begin
        AP := 'p';
        Hour := Hour - 12;
      End Else AP := 'a';
      If Hour = 0 then Hour := 12;
      Minute := (FileTime shl 5) shr 10;
      GotoXY(17,5);ClrEol;
      Write(Hour:2,':');
      If Minute < 10 then Write('0');
      Write(Minute,ap);
      GotoXY(17,6);
      Write(Month:2,'-');
      If Day < 10 then Write('0');
      Write(Day,'-',Year);
      GotoXY(17,7);ClrEol;
      Write(Size:0:0);
      GotoXY(17,8);Write(' ');GotoXY(17,8);
      If Floppy then Write('Yes') Else Write('No ');
      GotoXY(34,8);ClrEol;
      Write(VolPath);
      GotoXY(17,9);Write('   ');
      GotoXY(17,9); If StandAlone then Write('Yes') else Write('No ');
      GotoXY(37,9);Write('        ');
      I:=Pos('.',ParentName);
      If I>1 then GotoXY(37,9);Write(Copy(ParentName,1,I-1));
      GotoXY(60,9);ClrEol;
      If I>1 then Write(Copy(ParentName,I+1,Length(ParentName)-I));
      GotoXY(1,13);ClrEol;
      Write(Keys);
      For I:=1 to 4 do begin
        GotoXY(1,I+16);ClrEol;
        Write(Description[I]);
      End;
    End;
  End; { procedure ShowData }

PROCEDURE PrintRec;
  VAR I:Integer;
      S:Name;
  Begin
    If not PrTest then Repeat
      Beep;
      SaveScreen;
      DrawBox(10,70,16,21);
      BigWindow(11,17,69,20);
      If MonitorType = 7 then begin
        HideCursor;
        For I:=1 to 4 do begin
          GotoXY(1,I);
          Write(ConstStr(' ',59));
        End;
        RestoreCursor;
      End Else ClrScr;
      HideCursor;
      GotoXY(5,2); WriteLn('Printer does not appear to be ready');
      GotoXY(5,3); WriteLn('Press any key when ready or ESC to return to menu');
      Repeat until KeyPressed;
      Read(Kbd,Ch);
      BigWindow(1,1,80,25);
      RestoreScreen;
      HideCursor;
      If (Ch = #27) and KeyPressed then Read(Kbd,Ch);
      If Ch = #27 then Exit;
    Until PrTest;
    GotoXY(1,1);
    TextColor(7+Blink);
    Write('PRINTING RECORD');
    NormVideo;
    With FileRec do begin
      If PrintCount=0 then WriteLn(Lst,ConstStr('=',79));
      S:=FileName;
      Repeat
        For I:=1 to Length(S) do If S[I]=' ' then Delete(S,I,1);
      Until I=Length(S);
      Write(Lst,S,'   ');
      Size := (FileSize[1] * 1.0) +
              (FileSize[2] * 256.0) +
              (FileSize[3] * 65536.0);
      Year := (FileDate shr 9) + 80;
      Month := (FileDate shl 7) shr 12;
      Day := (FileDate shl 11) shr 11;
      Hour := FileTime shr 11;
      If Hour >= 12 then begin
        AP := 'p';
        Hour := Hour - 12;
      End Else AP := 'a';
      If Hour = 0 then Hour := 12;
      Minute := (FileTime shl 5) shr 10;
      Write(Lst,Size:1:0,' Bytes  ');
      Write(Lst,Hour:2,':');
      If Minute < 10 then Write(Lst,'0');
      Write(Lst,Minute,ap,'  ');
      Write(Lst,Month:2,'-');
      If Day < 10 then Write(Lst,'0');
      Write(Lst,Day,'-',Year,'    ');
      If StandAlone then WriteLn(Lst,'Standalone File') else begin
        S:=ParentName;
        Repeat
          For I:=1 to Length(S) do If S[I]=' ' then Delete(S,I,1);
        Until I=Length(S);
        WriteLn(Lst,'Main File: ',S);
      End;
      WriteLn(Lst,'Located on: ',VolPath);
      WriteLn(Lst,'----Keywords',ConstStr('-',67));
      WriteLn(Lst,Keys);
      WriteLn(Lst,'----Description',ConstStr('-',64));
      For I:=1 to 4 do WriteLn(Lst,Description[I]);
      WriteLn(Lst,ConstStr('=',79));
      PrintCount:=PrintCount+1;
      If PrintCount=6 then begin
        Write(Lst,#12);
        PrintCount:=0;
      End;
    End;
    GotoXY(1,1);Write(ConstStr(' ',20));
  End; { procedure PrintRec }

PROCEDURE ShowDuplicate(N:Integer);
  VAR S1,S2:AnyStr;
      RecNum:Integer;
      Done,Printed:Boolean;
  Begin
    FKey:=Entry[N].EName+Entry[N].EExt;
    HideCursor;
    GotoXY(60,1);Write('Duplicate Record!');
    S2:=FKey;
    Printed:=False;
    OpenFiles;
    SearchKey(CIndex,RecNum,FKey);
    S1:=Copy(FKey,1,11);
    Done:=False;
    If Ok and (S1=S2) then begin
      Repeat
        If NOT Printed then ShowData(RecNum);
        Printed:=False;
        GotoXY(1,23);
        Write('Viewing Records Currently Entered in FILECAT Database...');
        GotoXY(9,25);
        Write('<E> Enter New Record for ',Copy(SourceDirectory,1,3),S2,'       <*> Print Record');
        GotoXY(1,24);
        Write('Press:  <N> Next  <P> Previous  <Q> Quit  <D> Delete  ');
        ClrEol;
        Repeat
          Read(Kbd,Ch);
          Ch:=Upcase(Ch);
          If NOT (Ch in ['N','P','Q','D','E','*']) then Boop;
        Until Ch in ['N','P','Q','D','E','*'];
        Case Ch of
          'Q','E' : Done:=True;
          'N' : Begin
                  NextKey(CIndex,RecNum,FKey);
                  GotoXY(1,1);
                  If NOT OK then Write('First Record') else Write(ConstStr(' ',14));
                  If NOT OK then NextKey(CIndex,RecNum,FKey);
                End;
          'P' : Begin
                  PrevKey(CIndex,RecNum,FKey);
                  GotoXY(1,1);
                  If NOT OK then Write('Last Record ') else Write(ConstStr(' ',14));
                  If NOT OK then PrevKey(CIndex,RecNum,FKey);
                End;
          'D' : Begin
                  Beep;
                  TextColor(7+Blink);
                  Write('Are you sure? Y/N ');
                  NormVideo;
                  RestoreCursor;
                  If YES then begin
                    DeleteRec(CFile,RecNum);
                    DeleteKey(CIndex,RecNum,FKey);
                    SearchKey(CIndex,RecNum,FKey);
                  End;
                  HideCursor;
                End;
          '*' : Begin
                  PrintRec;
                  Printed:=True;
                End;
        End;
      Until Done;
    End;
    CloseFiles;
    RestoreCursor;
  End; { procedure ShowDuplicate }

PROCEDURE EnterData;
  VAR I,Line,X,Y:Integer;
      Done:Boolean;
      S,S1:AnyStr;
      ExitSet:CharSet;
      TC:Char;

  PROCEDURE Message(S:Str80);
    Begin
      HideCursor;
      GotoXY(1,23);ClrEol;
      LowVideo;
      GotoXY(1,25);Write('Press:    <F4> to clear line     <F10> when entry is complete');
      NormVideo;
      GotoXY(1,24);ClrEol;
      Write(S);
      RestoreCursor;
    End; { procedure Message }

  Begin
    Done:=False;
    Line:=1;
    If Length(FTemp.ParentName)<12 then FTemp.ParentName:='        .   ';
    GotoXY(1,25);ClrEol;
    Repeat
      HideCursor;
      X:=WhereX;
      Y:=WhereY;
      GotoXY(77,25);
      If FirstCharDelete then begin
        TextColor(7+Blink);
        Write('FCD');
      End Else Write('   ');
      GotoXY(X,Y);
      RestoreCursor;
      ExitSet:=[#13,^Z,^E,^X];
      Case Line of
        1 : Begin
              GotoXY(17,9);Write('    ');
              Message('Answer <Y>es if no other files are required to run this file.');
              If FTemp.ParentName='        .   ' then FTemp.StandAlone:=True;
              If FTemp.StandAlone then S:='Yes' else S:='No ';
              InputStr(S,1,17,9,Yf,ExitSet,TC);
              If S[1]='Y' then begin
                FTemp.StandAlone:=True;
                HideCursor;
                GotoXY(37,9);Write('        ');
                GotoXY(60,9);Write('   ');
                RestoreCursor;
              End else begin
                FTemp.StandAlone:=False;
                HideCursor;
                S:=Copy(FTemp.ParentName,1,8);
                GotoXY(37,9);Write(S);
                S:=Copy(FTemp.ParentName,10,3);
                GotoXY(60,9);Write(S);
                RestoreCursor;
              End;
            End;
        2 : Begin
              Message('Enter MAIN file name if not standalone.  REPEAT Main file name if also Main.');
              S:=Copy(FTemp.ParentName,1,8);
              InputStr(S,8,37,9,Af,ExitSet,TC);
              For I:= 1 to Length(S) do S[I]:=Upcase(S[I]);
              If Pos('.',S)>0 then begin
                Boop;
                S:=Copy(S,1,Pos('.',S)-1);
              End;
              If Length(S)<8 then For I:=1 to 8-(Length(S)) do S:=S+' ';
              GotoXY(37,9);Write(S);
              For I:=1 to 8 do FTemp.ParentName[I]:=S[I];
            End;
        3 : Begin
              Message('Enter MAIN file name extension.');
              S:=Copy(FTemp.ParentName,10,3);
              Repeat
                If Pos('.',S)>0 then begin
                  Boop;
                  S:='';
                End;
                InputStr(S,3,60,9,Af,ExitSet,TC);
                For I:= 1 to Length(S) do S[I]:=Upcase(S[I]);
              Until Pos('.',S)=0;
              If Length(S)<3 then For I:=1 to 3-(Length(S)) do S:=S+' ';
              GotoXY(60,9);Write(S);
              For I:=1 to 3 do FTemp.ParentName[I+9]:=S[I];
            End;
        4 : Begin
              Message('Enter KEY WORDS, separating with spaces.  (F1 for Keyword List)');
              Repeat
                S:=FTemp.Keys;
                InputStr(S,79,1,13,Af,[#13,^Z,^E,^X,^Q],TC);
                If TC=^Q then begin
                  S1:=SelectKeyword;
                  If S1<>'' then begin
                    If (Length(S)+Length(S1))>78 then Boop
                      Else begin
                        If S='' then S:=S1 Else S:=S+' '+S1;
                      End;
                  End;
                End;
                NormVideo;
                For I:= 1 to Length(S) do S[I]:=Upcase(S[I]);
                GotoXY(1,13);Write(S);
                FTemp.Keys:=S;
              Until TC<>^Q;
            End;
        5..8 : Begin
                 Str(Line-4,S);
                 S:='Enter DESCRIPTION of file.  Line '+S+' of 4.';
                 Message(S);
                 S:=FTemp.Description[Line-4];
                 InputStr(S,79,1,12+Line,Af,ExitSet,TC);
                 FTemp.Description[Line-4]:=S;
               End;
      End;
      Case TC of
        #13,^X : Line:=Line+1;
            ^Z : Done:=True;
            ^E : Line:=Line-1;
      End;
      If Line<1 then Line:=5;
      If Line>8 then Line:=1;
      If (Line in [2..3]) and (FTemp.StandAlone=True) then
        If (TC in [#13,^X]) then Line:=4 else
        If TC=^E then Line:=1;
    Until Done;
    Message(' ');
    GotoXY(1,25);ClrEol;
    GotoXY(1,24);ClrEol;
    If FTemp.StandAlone then FTemp.ParentName:='        .   ';
  End; { procedure EnterData }

{.m finc02}

{$I FMAIN03.INC}

{.m mainmodule}

PROCEDURE Inp;
  VAR N,I : Integer;
      S,SK:AnyStr;
      S1:String[4];
  Begin
    If ReportChoice<>'c' then begin
      If MonitorType = 7 then begin
        For I:=7 to 25 do begin
          GotoXY(1,I);
          ClrEol;
        End;
      End Else begin
        BigWindow(1,7,80,25);
        ClrScr;
      End;
      BigWindow(1,8,80,24);
      Beep;
      GotoXY(1,1);
      WriteLn('Position printer at beginning of new page.  Press any key when ready.');
      Read(Kbd,Ch);
      HideCursor;
    End;
    OpenFiles;
    For N := 1 to FileLen(CFile)-1 do begin
      GetRec(CFile,N,FTemp);
      If FTemp.Status=0 then begin
        Case ReportChoice of
          '1' : Begin
                  S:=FTemp.Keys;
                  WriteLn(S);
                  While Length(S)>0 do begin
                    Parse(S,SK);
                    SortKey:=SK;
                    If Length(SortKey)>30 then SortKey:=Copy(SortKey,1,30);
                    WriteLn('    ',SortKey);
                    Str(N:4,S1);
                    SortKey:=SortKey+ConstStr(' ',26-Length(SortKey))+FTemp.FileName+S1;
                    SortRelease(SortKey);
                  End;
                End;
          '3' : Begin
                  SortKey80:=FTemp.VolPath;
                  S:=FTemp.FileName;
                  While Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
                  Write(S);
                  If FTemp.Floppy then Write(' on diskette ')
                    Else Write(' in ');
                  WriteLn(SortKey80);
                  Str(N:4,S1);
                  SortKey80:=SortKey80+ConstStr(' ',64-Length(SortKey80));
                  SortKey80:=SortKey80+FTemp.FileName+S1;
                  SortRelease(SortKey80);
                End;
          '4' : If NOT FTemp.StandAlone then Begin
                  SortKey:=FTemp.ParentName;
                  S:=SortKey;
                  While Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
                  Write(S,' <-- ');
                  SortKey:=SortKey+Ftemp.FileName;
                  S:=FTemp.FileName;
                  While Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
                  WriteLn(S);
                  Str(N:4,S1);
                  SortKey:=SortKey+ConstStr(' ',38-Length(SortKey));
                  SortKey:=SortKey+S1;
                  SortRelease(SortKey);
                End;
          '5' : Begin
                  SortKey:=Copy(FTemp.FileName,10,3);
                  WriteLn(SortKey,' <-- ',FTemp.FileName);
                  SortKey:=SortKey+Ftemp.FileName;
                  Str(N:4,S1);
                  SortKey:=SortKey+ConstStr(' ',38-Length(SortKey));
                  SortKey:=SortKey+S1;
                  SortRelease(SortKey);
                End;
          'c' : If (NOT FTemp.StandAlone) and
                   (FTemp.ParentName=ChildMatch) and
                   (FTemp.ParentName<>FTemp.FileName) then Begin
                  SortKey:=FTemp.ParentName;
                  S:=SortKey;
                  While Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
                  Str(N:4,S1);
                  SortKey:=SortKey+ConstStr(' ',38-Length(SortKey));
                  SortKey:=SortKey+S1;
                  SortRelease(SortKey);
                End;
        End; { case ReportChoice}
      End;
    End;
    CloseFiles;
    BigWindow(1,1,80,25);
  End; { procedure Inp }

FUNCTION Less;
  VAR First  : Str42 Absolute X;
      Second : Str42 Absolute Y;
      First80  : Str80 Absolute X;
      Second80 : Str80 Absolute Y;
  Begin
    Case ReportChoice of
      '1','4','5','c' : Less:= First<Second;
      '3'             : Less:= First80<Second80;
    End; { case ReportChoice}
  End; { function Less }

PROCEDURE OutP;
  CONST Header1 = 'Alphabetical Listing of Keywords and Related Files';
        Header2 = 'Alphabetical Listing of Disks/Directories and Related Files';
        Header3 = 'Alphabetical Listing of Main/Associated File Groups';
        Header4 = 'Files Listed Alphabetically by Extension';
  VAR N,I,Count,Page:Integer;
      S1,S2,S3,Head:Str80;
  Begin
    If ReportChoice <> 'c' then begin
      If MonitorType = 7 then begin
        For I:=7 to 25 do begin
          GotoXY(1,I);
          ClrEol;
        End;
      End Else begin
        BigWindow(1,7,80,25);
        ClrScr;
      End;
      BigWindow(1,8,80,24);GotoXY(1,1);
      WriteLn('---- SORTING COMPLETE, NOW PRINTING --------------');
      WriteLn;
      If NOT PRTest then repeat
        Beep;
        WriteLn('PRINTER NOT READY. Please correct and press any key when ready or ESC to Quit.');
        Read(Kbd,Ch);
        If (Ch=#27) and (NOT Keypressed) then begin
          BigWindow(1,1,80,25);
          Exit;
        End;
      until PRTest;
      HideCursor;
    End;
    OpenFiles;
    S3:='';
    Page:=1;
    Case ReportChoice of
      '1' : Head:=Header1;
      '3' : Head:=Header2;
      '4' : Head:=Header3;
      '5' : Head:=Header4;
    End;
    Head:=Head+' on '+TDate;
    While NOT SortEOS do begin
      If (Page=1) and (ReportChoice<>'c') then begin
        WriteLn(Lst,Head,ConstStr(' ',71-Length(Head)),'Page ',Page);
        WriteLn(Lst,ConstStr('-',79));
        WriteLn(Lst);
        Page:=Page+1;
        Count:=3;
      End;
      Case ReportChoice of
        '1' : Begin
                SortReturn(SortKey);
                S2:=Copy(SortKey,1,26);
                If S2<>S3 then begin
                  WriteLn(Lst,S2);
                  Count:=Count+1;
                  S3:=S2;
                End;
                S1:=Copy(SortKey,39,4);
                While S1[1]=' ' do S1:=Copy(S1,2,Length(S1));
                Val(S1,N,I);
                GetRec(CFile,N,FTemp);
                S1:=FTemp.FileName;
                While Pos(' ',S1)>0 do Delete(S1,Pos(' ',S1),1);
                WriteLn('-> ',S2,S1);
                If FTemp.Floppy then WriteLn(Lst,'   ',S1,' on diskette ',FTemp.VolPath)
                  Else WriteLn(Lst,'   ',S1,' in subdirectory ',FTemp.VolPath);
                Count:=Count+1;
              End;
        '3' : With FTemp do begin
                SortReturn(SortKey80);
                S2:=Copy(SortKey80,1,64);
                If S2<>S3 then begin
                  S3:=S2;
                  WriteLn(Lst,S2);
                  Count:=Count+1;
                End;
                S1:=Copy(SortKey80,77,4);
                While S1[1]=' ' do S1:=Copy(S1,2,Length(S1));
                Val(S1,N,I);
                GetRec(CFile,N,FTemp);
                S1:=FileName;
                While Pos(' ',S1)>0 do Delete(S1,Pos(' ',S1),1);
                WriteLn('-> ',S1);
                Write(Lst,'   ',S1,ConstStr(' ',12-Length(S1)));
                Size := (FileSize[1] * 1.0) +
                        (FileSize[2] * 256.0) +
                        (FileSize[3] * 65536.0);
                Year := (FileDate shr 9) + 80;
                Month := (FileDate shl 7) shr 12;
                Day := (FileDate shl 11) shr 11;
                Hour := FileTime shr 11;
                If Hour >= 12 then begin
                  AP := 'p';
                  Hour := Hour - 12;
                End Else AP := 'a';
                If Hour = 0 then Hour := 12;
                Minute := (FileTime shl 5) shr 10;
                Write(Lst,Size:8:0,' Bytes',Hour:4,':');
                If Minute < 10 then Write(Lst,'0');
                Write(Lst,Minute,ap,Month:4,'-');
                If Day < 10 then Write(Lst,'0');
                Write(Lst,Day,'-',Year,'   ');
                If StandAlone then WriteLn(Lst,'Standalone File') else begin
                  S1:=ParentName;
                  While Pos(' ',S1)>0 do Delete(S1,Pos(' ',S1),1);
                  WriteLn(Lst,'Main File: ',S1);
                End;
                Count:=Count+1;
              End;
    '4','5' : Begin
                SortReturn(SortKey);
                If ReportChoice='4' then S2:=Copy(SortKey,1,12);
                If ReportChoice='5' then S2:=Copy(SortKey,1,3);
                If S2<>S3 then begin
                  S3:=S2;
                  While S2[1]=' ' do S2:=Copy(S2,2,Length(S1));
                  If ReportChoice='4' then WriteLn(Lst,S2);
                  If ReportChoice='5' then WriteLn(Lst);
                  Count:=Count+1;
                End;
                S1:=Copy(SortKey,39,4);
                While S1[1]=' ' do S1:=Copy(S1,2,Length(S1));
                Val(S1,N,I);
                GetRec(CFile,N,FTemp);
                S1:=FTemp.FileName;
                While Pos(' ',S1)>0 do Delete(S1,Pos(' ',S1),1);
                WriteLn('-> ',S1);
                If FTemp.Floppy then WriteLn(Lst,'   ',S1,' on diskette ',FTemp.VolPath)
                  Else WriteLn(Lst,'   ',S1,' in subdirectory ',FTemp.VolPath);
                Count:=Count+1;
              End;
        'c' : Begin
                SortReturn(SortKey);
                If ChildCount<150 then begin
                  ChildCount:=ChildCount+1;
                  ChildArray[ChildCount].CName:=Copy(SortKey,1,12);
                  S1:=Copy(SortKey,39,4);
                  While S1[1]=' ' do S1:=Copy(S1,2,Length(S1));
                  Val(S1,N,I);
                  ChildArray[ChildCount].CNum:=N;
                End;
              End;
      End; { case ReportChoice}
      If (Count>=55) and (ReportChoice<>'c') then begin
        Write(Lst,#12);
        WriteLn(Lst,Head,ConstStr(' ',71-Length(Head)),'Page ',Page);
        WriteLn(Lst,ConstStr('-',79));
        WriteLn(Lst);
        Page:=Page+1;
        Count:=3;
      End;
    End;
    If ReportChoice<>'c' then Write(Lst,#12);
    CloseFiles;
    BigWindow(1,1,80,25);
  End; { procedure OutP }

PROCEDURE ReportMenu;
  CONST N = 15;
  VAR S:Str80;
      I:Integer;
      NewReportMenu:Boolean;
  Begin
  NewReportMenu:=False;
  Repeat
    If NewReportMenu then DisplayID Else Begin
      If MonitorType = 7 then begin
        For I:=7 to 25 do begin
          GotoXY(1,I);
          ClrEol;
        End;
      End Else begin
        BigWindow(1,7,80,25);
        ClrScr;
      End;
      BigWindow(1,1,80,25);
    End;
    NewReportMenu:=False;
    NormVideo;
    GotoXY(26,08); Write('REPORTS and UTILITIES MENU');
    GotoXY(N,10); WriteLn('1 -- PRINT Listing of Keywords and Related Files');
    GotoXY(N,11); WriteLn('2 -- PRINT Alphabetical List of All Files');
    GotoXY(N,12); WriteLn('3 -- PRINT Listing of Disks and Related Files');
    GotoXY(N,13); WriteLn('4 -- PRINT Listing of Main/Associated File Groups');
    GotoXY(N,14); WriteLn('5 -- PRINT Files Listed Alphabetically by Extension');
    GotoXY(N,15);
    If TransferFile then
      WriteLn('6 -- MOVE Transfer File to Current Source Drive')
    Else WriteLn('6 -- CREATE and WRITE to Transfer File');

    GotoXY(N,17); WriteLn('7 -- TEST SOURCE Diskette for Duplicates');
    GotoXY(N,18); WriteLn('8 -- TEST FILECAT Database for Duplicates');
    GotoXY(N,20); WriteLn('C -- PRINT Disk Catalog / Compare Active Files');

    LowVideo;
    GotoXY(N,22); WriteLn('9 -- Return to MAIN MENU');
    NormVideo;
    GotoXY(N,24); Write('Enter your selection: [ ]');
    Repeat
      GotoXY(N+23,WhereY);
      Read(Kbd,ReportChoice);
      Write(ReportChoice);
      Case ReportChoice of
        'c','C' : Begin
                    DiskCatalog;
                    NewMenu:=True;
                  End;
        '1',
        '4',
        '5' : Begin
                I:=TurboSort(SizeOf(SortKey));
                NewReportMenu:=True;
              End;
        '2' : Begin
                PrintAll;
                If PrintCount<>0 then Write(Lst,#12);
                PrintCount:=0;
                NewReportMenu:=True;
              End;
        '3' : Begin
                I:=TurboSort(SizeOf(SortKey80));
                NewReportMenu:=True;
              End;
        '6' : Begin
                If MonitorType = 7 then begin
                  For I:=7 to 25 do begin
                    GotoXY(1,I);
                    ClrEol;
                  End;
                End Else begin
                  BigWindow(1,7,80,25);
                  ClrScr;
                End;
                BigWindow(1,1,80,25);
                NewReportMenu:=True;
                If NOT TransferFile then begin
                  GotoXY(28,14); Write('Creating Transfer File...');
                  ChDir(EntryDirectory);
                  MakeFile(CFile,'TRANSFER.DAT',SizeOf(FRec));
                  MakeIndex(CIndex,'TRANSFER.IXN',14,1);
                  CloseFile(CFile);
                  CloseIndex(CIndex);
                  TransferFile:=True;
                End Else begin
                  GotoXY(10,13);
                  HideCursor;
                  Write('Do you wish to MOVE the transfer file to ',SourceDirectory,'? Y/N');
                  If YES then begin
                    MoveFiles;
                    GotoXY(10,13); ClrEol;
                    Write('ADD the transfer file data to the master database? Y/N');
                    IF YES then begin
                      S:=EntryDirectory;
                      If S[Length(S)]<>'\' then S:=S+'\';
                      AddTransfer(S);
                    End;
                    DeleteTransfer;
                    TransferFile:=False;
                  End;
                End;
              End;
        '7' : Begin
                INT24On;
                {$I-}
                ChDir(SourceDirectory);
                {$I+}
                I:=INT24Result;
                INT24Off;
                If I=0 then begin
                  BuildArray;
                  QuickSortRecord(Entry,EntryNum);
                  If EntryNum>0 then TestIt;
                End Else Boop;
                ChDir(EntryDirectory);
              End;
        '8' : Begin
                ChDir(EntryDirectory);
                TestIt2;
              End;
        '9' : ;
      Else Boop;
      End;
    Until ReportChoice in ['1'..'9','C','c'];
  Until ReportChoice in ['6'..'9','C','c'];
  End;  { procedure ReportMenu }

PROCEDURE KillTemp;
  Begin
    If Exist('FILECAT.TMP') then begin
      Assign(ExFile,'FILECAT.TMP');
      Erase(ExFile);
    End;
  End; { procedure KillTemp }

PROCEDURE Menu;
  LABEL NameIt;
  CONST N = 20;
  VAR S:Str80;
      I:Integer;
      R:Real;

  PROCEDURE GetVolumeName;
    Begin
      INT24On;
      {$I-}
      ChDir(SourceDirectory);
      {$I+}
      I:=INT24Result;
      INT24Off;
      If I<>0 then Begin
        Beep;
        GotoXY(30,9);ClrEol;
        Write(SourceDirectory,' Drive Not Ready');
        OldVolumeName:='<NONE>';
        OldVolumeNameDate:='';
      End Else Volume(SourceDirectory[1],False);
      ChDir(EntryDirectory);
      LowVideo;
      GotoXY(17,10); ClrEol;
      Write('Volume Name: ',OldVolumeName,'   ',OldVolumeNameDate);
    End; { procedure GetVolumeName }

  Begin
  Repeat
    NormVideo;
    If NewMenu then DisplayID Else Begin
      If MonitorType = 7 then begin
        For I:=7 to 25 do begin
          GotoXY(1,I);
          ClrEol;
        End;
      End Else begin
        BigWindow(1,7,80,25);
        ClrScr;
      End;
      BigWindow(1,1,80,25);
    End;
    For I:=1 to Length(EntryDirectory) do
      EntryDirectory[I]:=UpCase(EntryDirectory[I]);
    Repeat
      S:=EntryDirectory;
      If EntryDirectory[Length(EntryDirectory)]='\'then
        S := S + 'FILECAT.DAT' Else
        S := S + '\FILECAT.DAT';
      If NOT Exist(S) then begin
        GotoXY(5,12);
        Write('Please place the');
        GotoXY(5,13);
        Write('FILECAT data disk in ',EntryDirectory);
        GotoXY(5,16);
        Beep;
        HideCursor;
        Write('Press  <Y>  to create new files on ',EntryDirectory[1],':');
        GotoXY(5,17);
        Write('      <ESC> to Quit and return to DOS');
        GotoXY(5,18);
        Write('       <C>  to continue...');
        Repeat
          Read(Kbd,Ch);
          If (Ch=#27) and Keypressed then Read(Kbd,Ch);
          Ch:=Upcase(Ch);
          Case Ch of
            #27 : Begin
                    ClrScr;
                    RestoreCursor;
                    Halt;
                  End;
            'Y' : Begin
                    KillTemp;
                    InitializeFiles;
                  End;
            'C' : ;
            Else Boop;
          End;
        Until Ch in ['C','Y',#27];
        RestoreCursor;
        If MonitorType = 7 then begin
          For I:=7 to 25 do begin
            GotoXY(1,I);
            ClrEol;
          End;
        End Else begin
          BigWindow(1,7,80,25);
          ClrScr;
        End;
        BigWindow(1,1,80,25);
      End;
    until Exist(S);
    R:=FreeSpace;

    LowVideo;
    HideCursor;
    GotoXY(10,8); Write('FILECAT Resides on: ',EntryDirectory);
    If R<2000.0 then NormVideo;
    GotoXY(1,25); Write(R:1:0,' Left on ',EntryDirectory);
    If R<2000.00 then begin
      Beep;
      Textcolor(7+Blink);
      Write(' <--Disk almost full!');
      Delay(2000);
      LowVideo;
    End;
    If TransferFile then begin
      Beep;
      Textcolor(7+Blink);
      GotoXY(49,25);
      Write('> WORKING ON A TRANSFER FILE <');
      LowVideo;
    End;
    GotoXY(70,8); Write('DOS: ',DOSNum);
    GotoXY(6,9); ClrEol; Write('Source Drive/Directory: ',SourceDirectory);
    OldVolumeName := '';
    OldVolumeNameDate := '';
    NormVideo;
    GotoXY(N,12); WriteLn('1 -- CHANGE Source Drive/Directory');
    GotoXY(N,13); WriteLn('2 -- ENTER New File Data');
    GotoXY(N,14); WriteLn('3 -- SEARCH Database for KEYWORD MATCH');
    GotoXY(N,15); WriteLn('4 -- BROWSE/EDIT Database Records');
    GotoXY(N,16); WriteLn('5 -- REPORTS and UTILITIES');
    GotoXY(N,17); WriteLn('6 -- LABEL Source Diskette');
    LowVideo;
    GotoXY(N,19); WriteLn('7 -- Set Epson Print Codes');
    GotoXY(N,20); WriteLn('8 -- Change Color');
    GotoXY(N,21); WriteLn('9 -- End');
    If SourceDirectory[1] in ['A','B'] then begin
      GetVolumeName;
      If I=0 then begin
        ChDir(SourceDirectory);
        If Exist('TRANSFER.DAT') then begin
          GotoXY(1,11);
          NormVideo;
          Beep;
          Write('TRANSFER file found on Source Directory...');
          Delay(2000);
          Beep;
          Write(' Add to master database?  Y/N ');
          LowVideo;
          If YES then Begin
            S:=SourceDirectory;
            If S[Length(S)]<>'\' then S:=S+'\';
            S:=S+'TRANSFER.DXT';
            If Exist(S) then begin
              Assign(ExFile,S);
              Erase(ExFile);
            End;
            S:=SourceDirectory;
            If S[Length(S)]<>'\' then S:=S+'\';
            AddTransfer(S);
            GotoXY(1,11); ClrEol;
            GotoXY(10,11); Write('Transfer complete...TRANSFER.DAT renamed to TRANSFER.DXT');
            S:=S+'TRANSFER.DAT';
            Assign(ExFile,S);
            S:=SourceDirectory;
            If S[Length(S)]<>'\' then S:=S+'\';
            S:=S+'TRANSFER.DXT';
            Rename(ExFile,S);
          End Else begin
            GotoXY(1,11);
            ClrEol;
          End;
        End;
      End;
      ChDir(EntryDirectory);
      NormVideo;
    End;
    NormVideo;
    GotoXY(N,23); Write('Enter your selection: [ ]');
    KeySearch:=False;
    Repeat
      ReStoreCursor;
      GotoXY(N+23,WhereY);
      Read(Kbd,MenuChoice);
      Write(MenuChoice);
      If MenuChoice in ['2'..'5'] then begin
        Repeat
          INT24On;
          {$I-}
          ChDir(EntryDirectory);
          {$I+}
          I:=INT24Result;
          INT24Off;
          If I<>0 then Begin
            Beep;
            GotoXY(30,8);ClrEol;
            Write(EntryDirectory,' Drive Not Ready');
            Read(Kbd,Ch);
          End;
        Until I=0;
        If (NOT Exist('FILECAT.DAT')) or
           (NOT Exist('FILECAT.IXN')) then Menu;
        If (Exist('TRANSFER.DAT')) and
           (Exist('TRANSFER.IXN')) then TransferFile:=True Else TransferFile:=False;
      End;
      Case MenuChoice of
        '1' : Begin                          { Change Directory }
                NewMenu:=False;
                S := '';
                GotoXY(30,9); ClrEol;
                ReadLn(S);
                If Length(S)=1 then S:=S+':';
                If Length(S)=2 then S:=S+'\';
                INT24On;
                {$I-}
                ChDir(S);
                {$I+}
                For I:=1 to Length(S) do S[I]:=UpCase(S[I]);
                I:=INT24Result;
                INT24Off;
                If (I<>0) or (S='') then Begin
                  Beep;
                  GotoXY(30,9);
                  Write('Drive Not Ready or Illegal Definition');
                  Delay(3000);
                End Else SourceDirectory:=S;
                LowVideo;
                GotoXY(10,9); WriteLn('  Source Directory: ',SourceDirectory);
                NormVideo;
                ChDir(EntryDirectory);
              End;
        '2' : Begin
                NewMenu:=True;
                If SourceDirectory[1] in ['A','B'] then GetVolumeName;
                INT24On;
                {$I-}
                ChDir(SourceDirectory);
                {$I+}
                I:=INT24Result;
                INT24Off;
                If I=0 then begin
                  BuildArray;
                  If EntryNum>0 then DoEntry;
                  KillTemp;
                End Else Begin
                  Beep;
                  GotoXY(30,9); ClrEol;
                  Write(SourceDirectory,' Drive Not Ready');
                  Delay(3000);
                End;
                ChDir(EntryDirectory);
              End;
        '3' : Begin
                KeySearch:=True;
                BrowseEdit;
                NewMenu:=True;
              End;
        '4' : Begin
                BrowseEdit;
                NewMenu:=True;
              End;
        '5' : Begin
                NewMenu:=False;
                ReportMenu;
              End;
        '6' : If SourceDirectory[1] in ['A','B'] then begin
                Volume(SourceDirectory[1],True);
                GetVolumeName;
                NewMenu:=False;
              End;
        '7' : Begin
                SetEpson;
                NewMenu:=False;
              End;
        '8' : Begin
                CMode:=Not Cmode;
                If CMode then TextMode(3) Else TextMode(2);
                NewMenu:=True;
                Menu;
              End;
        '9' : If TransferFile then begin
                If MonitorType = 7 then begin
                  For I:=7 to 25 do begin
                    GotoXY(1,I);
                    ClrEol;
                  End;
                End Else begin
                  BigWindow(1,7,80,25);
                  ClrScr;
                End;
                BigWindow(1,1,80,25);
                HideCursor;
                Beep;
                GotoXY(22,12);
                Write('TRANSFER FILE CREATED and NOT MOVED!');
                GotoXY(24,14);
                Write('Do you still wish to EXIT?  Y/N');
                If NOT YES then Menu;
              End;
      Else Boop;
      End;
    Until MenuChoice in ['1'..'9'];
  Until MenuChoice = '9';
  End;

Begin
  InitIndex;
  KillTemp;
  PrintCount:=0;
  DOSNum:=CheckDosVersion;
  If MonitorType = 7 then begin
    TextMode(2);
    CMode:=False;
  End Else begin
    TextMode(3);
    CMode:=True;
  End;
  TDate := DOSDate;
  GetDir(0,EntryDirectory);
  OvrPath(EntryDirectory);
  If EntryDirectory[1]='A' then SourceDirectory:='B:\'
    Else SourceDirectory:='A:\';
  OldVolumeName:='';
  InitFiles:=False;
  If (Exist('TRANSFER.DAT')) and
     (Exist('TRANSFER.IXN')) then TransferFile:=True Else TransferFile:=False;
  NewMenu:=True;
  FirstCharDelete:=False;
  CurrentSaved:=False;
  KillTemp;
  Menu;
  ReStoreCursor;
  ClrScr;
  Beep;
  KillTemp;
  Goodbye;
End.